home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 20 / 5 / DISK2058.ZIP / UNFAST.EXE / OTHELLO.F < prev    next >
Text File  |  1980-01-01  |  8KB  |  458 lines
  1. ;FAST OTHELLO.
  2. const wx=30
  3. var sy,so,level,d,other,you,inlevel,x,y,c,first_x,first_y,b
  4. hl ? 8*8*2
  5. bo ? 8*8
  6. bs ? 5*8*8
  7.  
  8. function gbo(gx,gy) return bo-9+gx+gy*8
  9.  
  10. function gbs(gboard,gx,gy) return bs-73+gboard*64+gy*8+gx
  11.  
  12. function ghl(gx,gy) return hl+gy*16+gx*2-18
  13.  
  14. function gdirect(gx,gy) return peek (direct-6+gx*4+gy*2)
  15.  
  16. proc storeb(bl) move 32 from bo to bs+(bl-1)*64
  17.  
  18. proc restoreb(bl) move 32 from bs+(bl-1)*64 to bo
  19.  
  20. procedure set_place(colr)
  21.     {
  22.     pos=(y*3-2)*160+(x*5+wx+1)*2+1
  23.     repeat 2
  24.       {
  25.       repeat 4 video[pos]b=video[pos] xor colr:pos+=2
  26.       pos+=160-8
  27.       }
  28.     }
  29.  
  30. function get_points
  31.     {
  32.     points=1
  33.     if (b=1) or (b=8) or (c=1) or (c=8) then points=9
  34.     if ((c=1) or (c=8)) and ((b=1) or (b=8)) then points=180
  35.     if ((c=2) or (c=7)) and ((b=2) or (b=7)) then points=-180
  36.     if (((c=2) or (c=7)) and ((b=1) or (b=8))) or (((c=1) or (c=8)) and ((b=2) or (b=7)))
  37.       then points=10
  38.     return points
  39.     }
  40.  
  41. procedure total
  42.     {
  43.     sc=0
  44.  
  45.     b=1:c=1
  46.     for tm=0 to 63
  47.       if peekb (bo+tm)=sy then sc+=get_points*3
  48.       if peekb (bo+tm)=so then sc-=get_points
  49.     c++:if c=9 then c=1:b++
  50.     next tm
  51.  
  52.     tm=ghl(first_x,first_y)
  53.     if sc<peek tm then poke tm,sc
  54.     }
  55.  
  56. procedure testdirect
  57.     {
  58.     ok=0
  59.     xx=x:yy=y:first=1
  60.     testloop:
  61.     xx+=gdirect(d,1):yy+=gdirect(d,2)
  62.     if (peekb gbo(xx,yy)=0) or (xx<1) or (yy<1) or (xx>8) or (yy>8)
  63.     then goto exit
  64.     if (peekb gbo(xx,yy)<>other) and first then goto exit
  65.     first=0
  66.     if peekb gbo(xx,yy)<>you then goto testloop
  67.     ok=1
  68.     exit:
  69.     d++
  70.     }
  71.  
  72. procedure valid
  73.     {
  74.     ok=0
  75.     if peekb gbo(x,y) then goto endv
  76.     d=1
  77.     while (d<9) and (ok=0) testdirect
  78.     endv:
  79.     }
  80.  
  81. procedure flip
  82.     {
  83.     d=1
  84.     flip_rep:
  85.     testdirect
  86.     if ok then
  87.     {
  88.     xx=x:yy=y
  89.     lx=x:ly=y
  90.     test_flip:
  91.     pokeb gbo(xx,yy),you
  92.     xx+=gdirect(d-1,1):yy+=gdirect(d-1,2)
  93.     if peekb gbo(xx,yy)<>you then goto test_flip
  94.     }
  95.     if d<9 then goto flip_rep
  96.     }
  97.  
  98. procedure checkend
  99.     {
  100.     a=0
  101.     for x=1 to 8
  102.     for y=1 to 8
  103.     if not peekb gbo(x,y) then a++
  104.     next y,x
  105.     }
  106.  
  107. procedure process_level
  108.     {
  109.     inlevel--
  110.     swap you,other
  111.     for x=1 to 8
  112.     for y=1 to 8
  113.     valid
  114.     if ok then
  115.       {
  116.       storeb(inlevel)
  117.       if level=inlevel then first_x=x:first_y=y:inlevel=level
  118.  
  119.       flip
  120.       if inlevel>1 then
  121.     {
  122.     push x,y:process_level:pop y,x
  123.     }
  124.       else
  125.     {
  126.     total
  127.     }
  128.       restoreb(inlevel)
  129.       }
  130.     next y,x
  131.     inlevel++
  132.     }
  133.  
  134. procedure getcomp
  135.     {
  136.     storeb(level+1)
  137.     fill 64 from hl with 20000
  138.  
  139.     so=other:sy=you
  140.     swap you,other
  141.  
  142.     inlevel=level+1
  143.     process_level
  144.  
  145.     other=so:you=sy
  146.     restoreb(level+1)
  147.  
  148.     hlx=0:hly=0
  149.     loss=-10000
  150.  
  151.     for x=1 to 8
  152.     for y=1 to 8
  153.     tm=peek ghl(x,y)
  154.     if (tm<>20000) and (tm>loss) then loss=tm:hlx=x:hly=y
  155.     next y,x
  156.  
  157.     x=hlx:y=hly
  158.     valid
  159.     if not ok then
  160.       {
  161.       for x=1 to 8
  162.       for y=1 to 8
  163.     valid
  164.     if ok then hlx=x:hly=y
  165.       next y,x
  166.       }
  167.  
  168.     x=hlx:y=hly
  169.     }
  170.  
  171. procedure sd
  172.     {
  173.     tx=x:ty=y
  174.     for x=1 to 8
  175.     for y=1 to 8
  176.       valid
  177.       if ok then set_place(78h)
  178.     next y,x
  179.     x=tx:y=ty
  180.     }
  181.  
  182. procedure show
  183.     {
  184.     sd
  185.     locate 20,0
  186.     print "Press any key to continue."
  187.     wait for key
  188.     locate 20,0
  189.     print "                          "
  190.     sd
  191.     }
  192.  
  193. procedure getyou
  194.     {
  195.     quit=0
  196.     x=lx:y=ly
  197.     curset:
  198.     valid:cc=40h:if ok then cc=78h
  199.     set_place(cc)
  200.     wait for keypressed
  201.     ks=keyscan:k=lcase low ks:s=high ks
  202.     set_place(cc)
  203.     if k='q' then quit=1:k=13
  204.     if k='s' then show
  205.     if s=72 then
  206.     {
  207.     y--:if y<1 then y=8
  208.     }
  209.     if s=80 then
  210.     {
  211.     y++:if y>8 then y=1
  212.     }
  213.     if s=75 then
  214.     {
  215.     x--:if x<1 then x=8
  216.     }
  217.     if s=77 then
  218.     {
  219.     x++:if x>8 then x=1
  220.     }
  221.     if k<>13 then goto curset
  222.     lx=x:ly=y
  223.     }
  224.  
  225. ;         START MAIN PROGRAM
  226. start_game:
  227.  
  228. lpass=0
  229. colour 7
  230. cls
  231. you=1:lx=1:ly=1
  232. locate 3,36
  233. colour 15:print "OTHELLO"
  234. locate 7,10
  235. colour 6
  236. print "How many human players (0-2)?";
  237. get_players:
  238. loctocur
  239. pl=inputb
  240. if pl>2 then goto get_players
  241. if pl<>2 then
  242.     {
  243.     locate 10,10
  244.     print "Computer(2) skill level (1-4)?";
  245.     get_sk1:
  246.     loctocur
  247.     lv2=inputb
  248.     if (lv2<1) or (lv2>4) then goto get_sk1
  249.     }
  250. if not pl then
  251.     {
  252.     locate 13,10
  253.     print "Computer(1) Skill level (1-4)?";
  254.     get_sk2:
  255.     loctocur
  256.     lv1=inputb
  257.     if (lv1<1) or (lv1>4) then goto get_sk2
  258.     }
  259.  else
  260.     {
  261.     locate 13,10
  262.     print "Who starts? (B=BLACK W=WHITE) ";
  263.     get_start:
  264.     loctocur
  265.     wait for keypressed
  266.     k=lcase key
  267.     if (k<>'b') and (k<>'w') then goto get_start
  268.     you=2:if k='b' then you=1
  269.     }
  270.  
  271. colour 7
  272. cls
  273. fill 32 from bo with 0
  274.  
  275. pokeb gbo(4,4),1
  276. pokeb gbo(5,5),1
  277. pokeb gbo(4,5),2
  278. pokeb gbo(5,4),2
  279. locate 0,10
  280. colour 15:print "OTHELLO"
  281.  
  282. colour 7
  283. for y=1 to 8
  284. for x=1 to 8
  285. if y>1 then
  286.   {
  287.   locate y*3-3,x*5+wx+1
  288.   repeat 4 print chr 205;
  289.   if x<8 then print chr 206;
  290.   }
  291. if x<>1 then
  292.   {
  293.   locate y*3-2,x*5+wx
  294.   print chr 186;
  295.   locate y*3-1,x*5+wx
  296.   print chr 186;
  297.   }
  298. next x,y
  299.  
  300. for x=1 to 8
  301.   locate 0,x*5+wx+1
  302.   repeat 4 print chr 205;
  303.   print chr 203;
  304.   locate 24,x*5+wx+1
  305.   repeat 4 print chr 205;
  306.   print chr 202;
  307.   locate x*3-3,wx+5
  308.   print chr 204;
  309.   locate x*3-2,wx+5
  310.   print chr 186;
  311.   locate x*3-1,wx+5
  312.   print chr 186;
  313.   locate x*3-3,wx+45
  314.   print chr 185;
  315.   locate x*3-2,wx+45
  316.   print chr 186;
  317.   locate x*3-1,wx+45
  318.   print chr 186;
  319. next x
  320.  
  321. locate 0,wx+5:print chr 201;
  322. locate 24,wx+5:print chr 200;
  323. locate 0,wx+45:print chr 187;
  324. locate 24,wx+45:print chr 188;
  325.  
  326. display:
  327. colour 15
  328. for y=1 to 8
  329. for x=1 to 8
  330.   h=y*3-2:l=5*x+wx+2
  331.   c=32
  332.   if peekb gbo(x,y)=1 then c=176
  333.   if peekb gbo(x,y)=2 then c=219
  334.   locate h,l
  335.   print chr c;chr c;
  336.   locate h+1,l
  337.   print chr c;chr c;
  338. next x,y
  339.  
  340. colour 6
  341. b1=0:b2=0
  342. for y=1 to 8
  343. for x=1 to 8
  344.   if peekb gbo(x,y)=1 then b1++
  345.   if peekb gbo(x,y)=2 then b2++
  346. next x,y
  347. locate 14,0
  348. print "ENTER to go. Q to quit."
  349. print "S displays valid moves."
  350.  
  351. if pl<>2 then
  352.   {
  353.   locate 11,14
  354.   printb "L";chr('0'+lv2);
  355.   if pl=0 then locate 5,14:printb "L";chr('0'+lv1);
  356.   }
  357.  
  358. locate 3,1
  359. print "PLAYER ONE   ";chr 176;chr 176;
  360. locate 9,1
  361. print "PLAYER TWO   ";chr 219;chr 219;
  362. locate 4,14
  363. print chr 176;chr 176;
  364. locate 10,14
  365. print chr 219;chr 219;
  366. locate 5,1
  367. printb "BLACK = ";B1;
  368. locate 11,1
  369. printb "WHITE = ";B2;
  370. cursor 3,17
  371. if you=2 then cursor 9,17
  372. checkend
  373. if a then goto retry
  374. ascore:
  375. locate 20,1
  376. a=2-(b1>b2)
  377. if b1=b2
  378.     then print "THE GAME IS A DRAW!"
  379.     else print "PLAYER "chr ('0'+a)" HAS WON.";
  380. goto another
  381.  
  382. retry:
  383. other=1+(you=1)
  384. passed=1
  385. for x=1 to 8
  386. for y=1 to 8
  387.   valid
  388.   if ok then passed=0
  389. next y,x
  390. if passed then
  391.   {
  392.   if lpass then goto ascore
  393.   lpass=1
  394.   locate 22,1
  395.   print "PASS! Press ENTER"
  396.   wait for key=13
  397.   locate 22,1
  398.   print "                     ";
  399.   goto turn
  400.   }
  401. lpass=0
  402.  
  403. comp=1
  404. level=lv1:if you=2 then level=lv2
  405. if (pl=0) or ((pl=1) and (you=2))
  406.   then {
  407.        quit=0
  408.        getcomp
  409.        if key='q' then quit=1
  410.        }
  411.   else {
  412.        getyou
  413.        comp=0
  414.        }
  415. colour 6
  416. if quit then goto abort
  417.  
  418. valid
  419. if (ok=0) and (comp=1) then goto turn
  420. if not ok then beep:goto retry
  421. flip
  422.  
  423. turn:
  424. you++
  425. if you=3 then you=1
  426. goto display
  427.  
  428. abort:
  429. locate 22,1
  430. print "Do you want to quit (Y/N)?";
  431. abort_key:
  432. k=lcase key
  433. if (k<>'y') and (k<>'n') then goto abort_key
  434. locate 22,1
  435. print "                               ";
  436. if k='n' then goto retry
  437. p1:
  438. another:
  439. pp:
  440. locate 22,1
  441. print "Another game (Y/N)?";
  442. anok:
  443. k=lcase key
  444. if k='y' then goto start_game
  445. if k<>'n' then goto anok
  446. cursor 24,0
  447. terminate
  448.  
  449. direct:
  450. data 0,-1
  451. data 1,-1
  452. data 1,0
  453. data 1,1
  454. data 0,1
  455. data -1,1
  456. data -1,0
  457. data -1,-1
  458.